home *** CD-ROM | disk | FTP | other *** search
/ CD Ware Multimedia 1995 May / cd Ware (Juegos) Epimundo.iso / DOS / PRGMMING / PBC30.ZIP / FORCEMAT.BAS < prev    next >
Encoding:
BASIC Source File  |  1994-11-12  |  1.4 KB  |  52 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        PBClone  Copyright (c) 1990-1994  Thomas G. Hanlin III        |
  4. '   |                                                                      |
  5. '   +----------------------------------------------------------------------+
  6.  
  7.  
  8.    DECLARE SUB StripChar (St$, Ch$, StLen%)
  9.  
  10. FUNCTION ForceMatch$(Pattern$, SourceFile$)
  11.    a$ = Pattern$
  12.    GOSUB Regularize
  13.    Pat$ = a$
  14.    a$ = SourceFile$
  15.    GOSUB Regularize
  16.    Src$ = a$
  17.    FOR tmp% = 1 TO 12
  18.       IF MID$(Pat$, tmp%, 1) = "?" THEN
  19.          Result$ = Result$ + MID$(Src$, tmp%, 1)
  20.       ELSE
  21.          Result$ = Result$ + MID$(Pat$, tmp%, 1)
  22.       END IF
  23.    NEXT
  24.    StripChar Result$, " ", tmp%
  25.    ForceMatch$ = LEFT$(Result$, tmp%)
  26.    EXIT FUNCTION
  27.  
  28. Regularize:
  29.    t% = INSTR(a$, ".")
  30.    IF t% THEN
  31.       l$ = LEFT$(LEFT$(a$, t% - 1), 8)
  32.       r$ = LEFT$(MID$(a$, t% + 1), 3)
  33.    ELSE
  34.       l$ = LEFT$(a$, 8)
  35.       r$ = ""
  36.    END IF
  37.    t% = INSTR(l$, "*")
  38.    IF t% THEN
  39.       l$ = LEFT$(l$, t% - 1) + STRING$(9 - t%, "?")
  40.    ELSE
  41.       l$ = LEFT$(l$ + SPACE$(8), 8)
  42.    END IF
  43.    t% = INSTR(r$, "*")
  44.    IF t% THEN
  45.       r$ = LEFT$(r$, t% - 1) + STRING$(4 - t%, "?")
  46.    ELSE
  47.       r$ = LEFT$(r$ + SPACE$(3), 3)
  48.    END IF
  49.    a$ = l$ + "." + r$
  50.    RETURN
  51. END FUNCTION
  52.